COMMENT ⊗   VALID 00004 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	MACROS TO MAKE FAIL EASIER
 00007 00003	HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)
 00009 00004	OPDEFS
 00010 ENDMK
⊗;
;MACROS TO MAKE FAIL EASIER
	DEFINE CAT $(A,B){A$B}

	↓P←←17

	FOR @$ I←0,16
<	AC.$I←I
>

	$←400000

	.PLEVEL←←0
	.SLEVEL←←0

;SUBROUTINE DECLARATIONS.  MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
	DEFINE NSUBR(NAME,X1,X2,X3,X4,X5)
{	BEGIN NAME
	INTERN NAME
	GLOBAL .PLEVEL
	GLOBAL .SLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
  .PLEVEL←.PLEVEL+1
 IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
   .PLEVEL←.PLEVEL+1
  IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
    .PLEVEL←.PLEVEL+1
   IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
     .PLEVEL←.PLEVEL+1
    IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
      .PLEVEL←.PLEVEL+1
}}}}}
↓NAME:	;}

;DEFINE AN ARGUMENT
	DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}

;END OF SUBROUTINE
	DEFINE SUBREND
{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	BLOCK 0
	BEND }

;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{	GLOBAL .SLEVEL,.PLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
 IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
  IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
   IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
    IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
}}}}}
	PUSHJ P,NAME
	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
}
;PUSH SOMETHING ONTO STACK
	DEFINE PUSHP(ARG)
<	PUSH P,ARG
	.PLEVEL←←.PLEVEL+1
>
	DEFINE POPP(ARG)
<	POP P,ARG
	.PLEVEL←←.PLEVEL-1
>

	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

IFNDEF POP0J
<	DEFINE POP0J <POPJ 17,>
	↓POP1J.:SUB 17,[XWD 2,2]↔JRST@2(17)↔DEFINE POP1J<JRST POP1J.>
	↓POP2J.:SUB 17,[XWD 3,3]↔JRST@3(17)↔DEFINE POP2J<JRST POP2J.>
	↓POP3J.:SUB 17,[XWD 4,4]↔JRST@4(17)↔DEFINE POP3J<JRST POP3J.>
	↓POP4J.:SUB 17,[XWD 5,5]↔JRST@5(17)↔DEFINE POP4J<JRST POP4J.>
>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

;	FOR @$ I←0,17{↓AC$I:0↔}
;	DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
;	DEFINE GETAC (N){LAC[XWD AC,2]↔BLT N}
	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR
	 ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

;FATAL ERROR MESSAGE.

IFNDEF FATAL.
<	DEFINE FATAL(STR){PUSHJ 17,FATAL.↔JFCL [ASCIZ/STR/]}
	FATAL.:OUTSTR[BYTE(7)15,12,106,101,124↔"AL - "⊗1↔0]
	PUSH P,1↔MOVE 1,@-1(P)↔OUTSTR (1)↔OUTSTR[ASCIZ/
/]↔	POP P,1↔INCHRW↔JRST .-1↔LIT
>
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}

;CHAIN TOGETHER INITIALIZING CODE
	DEFINE INITCODE
<IFAVL	.INITLINK
<	GLOBAL .INITLINK
	PUSHJ P,.+2
	JRST .INITLINK
 	↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>

;CHAIN TOGETHER BIT TABLES
	DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0 
;>	.BTLNK
	.BTLNK←←.BTLNK*1000000+$.
	.BTABL←←$.
	FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;>	RADIX50 0,BIT
>	BLOCK =36+.BTABL-$.
>

	DEFINE TAIL
<DOINIT:
	IFDEF .INITLINK < PUSHJ P,.INITLINK
>	IFDEF .BTLNK < EXTERNAL $M
	MOVE [.BTLNK]
	SKIPE [$M]
	MOVEM $M+3
	POP0J
>>
;;HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)
IFNDEF PUSHIT<

DEFINE PUSHACS
<	PUSHJ P,PUSHIT
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL+20
>
DEFINE POPACS
<	PUSHJ P,POPIT
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL-20
>

↑↑PUSHIT:
	PUSH P,0	; SAVE 0
	HLRE 0,P	; PICK UP COUNT
	ADDI 0,20	; ADD IN DISPLACEMENT
	XOR 0,P		; IF SIGNS ARE DIFFERENT, NOT ENOUGH STACK
	JUMPGE 0,PUSHOK
	POP P,0		; CAN'T DO IT, LOSE BIG
	OUTSTR [ASCIZ ⊗NOT ENOUGH ROOM TO PUSH ACS!!
⊗]
	SKIPN JOBDDT
	JRST [ OUTSTR[ASCIZ⊗YOU LOSE.	⊗]
	       HALT PUSHIT ]
↑↑DDTGO:OUTSTR[ASCIZ⊗YOU'RE IN DDT
⊗]
	POP P,JOBOPC
	JRST @JOBDDT
PUSHOK:	POP P,0		; GET BACK 0
	EXCH 0,(P)	;SAVE 0 AND GET RETURN.
	MOVEM 0,20(P)	;GEE, THIS WAY WE RETURN WITH A POPJ
	MOVEI 0,1(P)
	HRLI 0,1
	BLT 0,17(P)
	ADD P,[XWD 20,20]
	POPJ P,		;RETURN TO SENDER

↑↑POPIT:
	MOVSI 0,-17(P)
	HRRI 0,1
	BLT 0,17
	MOVE 0,20(P)
	EXCH 0,(P)
	POPJ P,
>
;OPDEFS
;ONE OF BGB'S WHICH I LIKE
	OPDEF GO     [JRST]
;MAKE RAID KNOW THE FOLLOWING
	OPDEF FIX    [FIX]
	OPDEF INCHWL [INCHWL]
	OPDEF OUTCHR [OUTCHR]
	OPDEF OUTSTR [OUTSTR]
	OPDEF HALT   [HALT]
	OPDEF JRSTF  [JRST 2,]
	OPDEF PGCLR  [PGIOT 2,]

	IODEND←←20000
	EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC